home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
MEDICAL
/
2608A.ZIP
/
GP.ZIP
/
ENTRECAL.SRC
< prev
next >
Wrap
Text File
|
1990-11-03
|
5KB
|
235 lines
;\|
;ENTRECAL.SRC Translated from ENTRECAL.EDT by Roger Mathew's EDT2SRC Ver 4.11
;REPONLY 12:02:57 PM 28/ 3/90 |
define(P29|A|29||)
define(ANS|A|1||)
define(COUNTER|N|4||)
define(TD|D|10||)
define(PR_CTR|N|2||)
define(TOTAL_MATCH|N|8|0|)
define(PER_CENT|N|3||)
define(TOTAL_MAT_CRIT|N|4||)
define(PERCENTAGE|N|8|2|)
define(REC_DATE|S|8||)
define(COUNT|N|4||)
define(SELECT.FLD.F1|A| 4||)
define(SELECT.FLD.T1|A| 4||)
define(SELECT.FLD.F2|S| 8||)
define(SELECT.FLD.T2|S| 8||)
define(SFT|A|1||)
define(DOB1|D|10||)
define(DOB2|D|10||)
define(CTR|N|1||)
define(MEM_DATE|S|8||)
define(FROM_DATE|S|8||)
define(MEM_COD|A|4||)
define(ENTER|A|1||)
define(FLAG|A|1||)
define(FLAG2|A|1||)
open(RECALLS||0|EXIT)
open(PATIENT||0|EXIT)
trap(Q|G|EXIT)
trap(I|G|EXIT)
date(TD|G)
mount(SELECT|S||)
START:
enter(FROM_DATE||||N|N|N|||N)
enter(CTR|"135"|||N|Y|N|||N)
SELECT.FLD.F1 = ("****")
enter(SFT|" MF"|||Y|Y|N|||N)
if CTR = (1) then DOB1 = (FROM_DATE-23741)
if CTR = (3) then DOB1 = (FROM_DATE-2190)
enter(DOB1||||N|Y|N|||N)
if CTR = (1) then DOB2 = (FROM_DATE-9131)
if CTR = (3) then DOB2 = (FROM_DATE)
enter(DOB2||||N|Y|N|||N)
FLAG_AGAIN:
enter(FLAG|"YN"|||Y|Y|N|||N)
if FLAG = ("Y") do
{
pmsg("DO YOU REALLY WANT TO ADD NAMES AT RISK TO THE RECALL REGISTER Y/N"|1|21|Y|N|S|FLAG)
if FLAG <> ("Y") goto FLAG_AGAIN
}
pmsg("IS ALL THE ABOVE CORRECT? Y/N:"|30|22|Y|N|S|ENTER)
if ENTER <> ("Y") then goto START
pchr(P|4)
pchr(P|1)
pset(100|66|66)
for(PR_CTR|1|20|1)
{
pmsg(""|1|1|N|N|P|)
}
pmsg("**** ADDED STARTING ON :";FROM_DATE;" USING FOLLOWING CRITERIA:"|1|1|N|N|P|)
pmsg("======================================================================"|1|1|N|N|P|)
pmsg("RECALL TYPE NUMBER: ";CTR|1|1|N|N|P|)
pmsg("SEX = ";SFT|1|1|N|N|P|)
pmsg("FROM DATE OF BIRTH: ";DOB1;" TO DATE OF BIRTH: ";DOB2|1|1|N|N|P|)
pmsg(""|1|1|N|N|P|)
pmsg("====================================================================="|1|1|N|N|P|)
for(PR_CTR|1|39|1)
{
pmsg(""|1|1|N|N|P|)
}
trap(I|G|FINI)
mount(SCREEN|R|P)
ptof
pchr(P|4)
pset(132|66|60)
pchr(P|1)
DATE.OF.BIRTH = (DOB1)
find(G|DATE.OF.BIRTH|NO.RECS|)
P29 = (PATIENT.NAME)
goto TESTIT
PRT.REC:
COD.REF = (RECORD.NUMBER)
find(M|COD.REF|PRINTITX|N)
goto PRINTITX
RD.NEXT:
clr(RECALLS|B)
find(N|PATIENT|FINI|)
if DATE.OF.BIRTH > (DOB2) goto FINI
pmsg(DATE.OF.BIRTH|1|1|N|N|S|)
P29 = (PATIENT.NAME)
goto TESTIT
FINI:
pmsg("TOTAL AT RISK:";TOTAL_MATCH|1|1|N|N|P|)
pmsg("TOTAL NEW RISKS:";TOTAL_MAT_CRIT|1|1|N|N|P|)
run("recmenu")
NO.RECS:
pmsg("There are no records in the RECALLS file "|1|24|Y|||)
EXIT:
run("recmenu")
TESTIT:
if SFT <> ("") then if SEX <> (SFT) goto RD.NEXT
if DOB1 <> (0) then if DOB1 > (DATE.OF.BIRTH) goto RD.NEXT
if DOB2 <> (0) then if DOB2 < (DATE.OF.BIRTH) goto RD.NEXT
TOTAL_MATCH = (TOTAL_MATCH+1)
goto PRT.REC
PRINTITX:
if COD[CTR] > ("") goto RD.NEXT
if COD.D[CTR] > (0) goto RD.NEXT
COD[CTR] = (SELECT.FLD.F1)
COD.REF = (RECORD.NUMBER)
COD.PAT.NAME = (P29)
TOTAL_MAT_CRIT = (TOTAL_MAT_CRIT+1)
pfmt(2|||N|N|)
save(RECALLS|N|Y)
goto RD.NEXT
DEL_RECS:
pmsg("YOU ARE ABOUT TO DELETE SMEAR RECORDS OF ALL WOMEN BORN BEFORE: ";DOB1|1|2|N|N|S|)
pmsg("DO YOU WISH TO CONTINUE? Y/N : "|1|3|Y|N|S|)
enter(ANS|"YN"|||Y|Y|N|31|3|N)
if ANS <> ("Y") then run("recmenu")
clrlne(1|2)
clrlne(1|3)
find(B|COD.REF|EXIT|)
goto TEST_AGE
TEST_AGE:
pmsg(RECORD.NUMBER|1|1|N|N|S|)
RECORD.NUMBER = (COD.REF)
find(M|RECORD.NUMBER|EXIT|)
if DATE.OF.BIRTH < (DOB1) do
{
if COD[1] > ("") then COD[1] = ("")
if COD.D[1] > (0) then COD.D[1] = (0)
if SM_DATE > (0) then SM_DATE = (0)
save(RECALLS|N|Y)
}
find(N|RECALLS|NEW_START|)
goto TEST_AGE
NEW_START:
ret
\STSELECT
THIS PROGRAM WILL MARK THOSE AT RISK WITH **** IN THE CODE - SMEARS/IMMUN
ENTERING TARGET DATE WILL ANTICIPATE NEARLY CORRECT DATES FOR GIVEN PERIOD
TARGETS ARE FPC QUARTERS -
╔═══════╗
║Targets║ ╔═════════════════════════════════════════════════════╗
║ 01/04 ║ ║ Target Date:& eg 01/04/90 ║
║ 01/07 ║ ║ RECALL NO:& eg 1 = smears 3 = immun ║
║ 01/10 ║ ║ Sex : & Blank for immunisations ║
║ 01/01 ║ ║ Date of Birth from:& 01/??/?? ║
╚═══════╝ ║ Date of Birth to :& 01/??/?? ║
╚═════════════════════════════════════════════════════╝
Esc to STOP CONTINUE Y/N:&
\
FROM_DATE
CTR
SFT
DOB1
DOB2
FLAG
\
\R SCREEN
& & & (& ) &
& & & NO RECALL ON FILE - recall added
\
P29
ADDRESS1
DATE.OF.BIRTH
MEM_COD
MEM_DATE
P29
ADDRESS1
DATE.OF.BIRTH
\